home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / iqb9103.zip / SCROLL.BAS < prev   
BASIC Source File  |  1991-02-22  |  3KB  |  138 lines
  1. ' Program - SCROLL.BAS
  2.  
  3. ' Demonstrates scrolling rectangular text areas using any
  4. ' standard video mode.  Text can be scrolled up n lines,
  5. ' down n lines, or the area can be completely blanked.
  6.  
  7. '$INCLUDE: 'QB.BI'
  8.  
  9. TYPE Rectangle
  10.    X1 AS INTEGER
  11.    Y1 AS INTEGER
  12.    X2 AS INTEGER
  13.    Y2 AS INTEGER
  14. END TYPE
  15.  
  16. DECLARE SUB Scroll (Rec AS Rectangle, Lines%, BlankColor%)
  17. DECLARE SUB WaitKey ()
  18.  
  19. ' This rectangle will contain upper left and lower right
  20. ' row and column text coordinates for scrolling.
  21. DIM Rec AS Rectangle
  22.  
  23. ' Let's get started.
  24. CLS
  25. PRINT "SCROLL.BAS"
  26. PRINT
  27. INPUT "Enter screen mode      >", Vmode%
  28. INPUT "Enter width (40 or 80) >", Vwidth%
  29. INPUT "Enter blanking color   >", BlankColor%
  30.  
  31. ' Set minimum number of lines for the given screen mode.
  32. IF Vmode% = 11 OR Vmode% = 12 THEN
  33.   Vlines% = 30
  34. ELSE
  35.   Vlines% = 25
  36. END IF
  37.  
  38. ' Set the screen mode, width, and lines.  The program will
  39. ' halt here if you select an illegal combination.
  40. SCREEN Vmode%
  41. WIDTH Vwidth%, Vlines%
  42.  
  43. ' Display text lines for demonstrating the scrolling.
  44. CLS
  45. FOR I% = 1 TO 8
  46.    PRINT STRING$(35, 64 + I%)
  47.    PRINT STRING$(35, "-")
  48. NEXT I%
  49.  
  50. LOCATE 25,50 : PRINT "Press any key to continue..."
  51. WaitKey     ' Wait for a keypress before 1st scroll
  52.  
  53. ' Scroll up one line.
  54. Rec.X1 = 5
  55. Rec.Y1 = 4
  56. Rec.X2 = 10
  57. Rec.Y2 = 12
  58. Scroll Rec, 1, BlankColor%
  59. WaitKey
  60.  
  61. ' Scroll down three lines.
  62. Rec.X1 = 15
  63. Rec.X2 = 20
  64. Scroll Rec, -3, BlankColor%
  65. WaitKey
  66.  
  67. ' Blank the entire rectangular area.
  68. Rec.X1 = 25
  69. Rec.X2 = 30
  70. Scroll Rec, 0, BlankColor%
  71. WaitKey
  72.  
  73. ' Finally, do "block-art" until any key is pressed.  This
  74. ' demonstrates the speed of the scrolling on your system.
  75. DO
  76.    ' Pick a random rectangular area of the screen.
  77.    Rec.X1 = INT(RND * Vwidth% + 1)
  78.    Rec.Y1 = INT(RND * Vlines% + 1)
  79.    Rec.X2 = INT(RND * Vwidth% + 1)
  80.    Rec.Y2 = INT(RND * Vlines% + 1)
  81.  
  82.    ' Make sure rows and columns are in the right order.
  83.    IF Rec.X1 > Rec.X2 THEN SWAP Rec.X1, Rec.X2
  84.    IF Rec.Y1 > Rec.Y2 THEN SWAP Rec.Y1, Rec.Y2
  85.  
  86.    ' Select a random blanking color.
  87.    IF Vmode% <> 13 THEN
  88.      BlankColor% = INT(RND * 16)
  89.    ELSE
  90.      BlankColor% = INT(RND * 256)
  91.    END IF
  92.  
  93.    ' Scroll the rectangular region, blanking all lines.
  94.    Scroll Rec, 0, BlankColor%
  95. LOOP WHILE INKEY$ = ""
  96. END
  97.  
  98. SUB Scroll (Rec AS Rectangle, Lines%, BlankColor%)
  99.                                     
  100.    DIM Regs AS RegType
  101.  
  102.    ' Get current video mode and character columns.
  103.    Regs.AX = &HF00
  104.    Interrupt &H10, Regs, Regs
  105.    VideoMode% = Regs.AX AND &HFF
  106.  
  107.    ' The blanking color attribute depends on the specific
  108.    ' video mode and number of text columns.
  109.    IF Regs.AX = &H2801 OR Regs.AX = &H5003 THEN
  110.      Attribute% = CVI(MKL$(BlankColor% * 4096&))
  111.    ELSEIF VideoMode% = 4 OR VideoMode% = 6 THEN
  112.      Attribute% = 0
  113.    ELSE
  114.      Attribute% = CVI(MKL$(BlankColor% * 256&))
  115.    END IF
  116.  
  117.    ' Load the registers.
  118.    IF Lines% < 0 THEN
  119.      Regs.AX = &H700 OR (ABS(Lines%) AND &HFF)
  120.    ELSE
  121.      Regs.AX = &H600 OR (Lines% AND &HFF)
  122.    END IF
  123.  
  124.    Regs.bx = Attribute%
  125.    Regs.cx = Rec.Y1 * 256 + Rec.X1 - 257
  126.    Regs.dx = Rec.Y2 * 256 + Rec.X2 - 257
  127.  
  128.    ' Call video scroll function.
  129.    Interrupt &H10, Regs, Regs
  130.     
  131. END SUB
  132.  
  133. ' Prompt the user to press a key
  134. SUB WaitKey STATIC
  135. BEEP : DO WHILE INKEY$ = "" : LOOP
  136. END SUB
  137.  
  138.